home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / ML_BME1.ZIP / RIPPLES / RIPPLES2.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-12-21  |  3.6 KB  |  150 lines
  1. {
  2.  Ripples generator, by Maple Leaf, Nov 1996
  3.  v2.0
  4.  ----------------------------------------------------------------------------
  5.  ASM RULES!!!! yup, yup.  the others suck.  assembler forever !
  6.  ----------------------------------------------------------------------------
  7.  Do whatever you want with this crappy code, but if you use parts of it in
  8.  your production(s), please send some greets to Maple Leaf (Gruian Radu).
  9.  Thanx.
  10. }
  11.  
  12. uses alloc, files, bitmap;
  13.  
  14. var vScr, sqrTab : word;
  15.     Img : pointer;
  16.     Pal : array[byte] of record r,g,b:byte end;
  17.  
  18.     Wave : array [0..199] of word;  { 200 words are quite enough ... }
  19.  
  20.     SinTab : array [byte] of longint;
  21.  
  22. procedure InitVideo;near;assembler;
  23. asm
  24.   mov ax,13h
  25.   int 10h  { init video mode }
  26.   mov dx,3c8h
  27.   mov al,0
  28.   out dx,al
  29.   inc dx
  30.   mov cx,768
  31.   mov si,offset pal
  32.   rep outsb { set palette }
  33. end;
  34.  
  35. procedure vWait;near;assembler;
  36. asm
  37.     mov dx,3DAh
  38. @1: in al,dx
  39.     test al,8
  40.     jne @1
  41. @2: in al,dx
  42.     test al,8
  43.     je @2
  44. end;
  45.  
  46. procedure ShowVScreen;near;assembler;
  47. asm
  48.   push ds
  49.   push es
  50.   mov cx,16000
  51.   mov ax,0A000h
  52.   mov es,ax
  53.   mov di,0
  54.   mov si,di
  55.   mov ds,VScr
  56.   cld
  57.   db 66h; rep movsw
  58.   pop es
  59.   pop ds
  60. end;
  61.  
  62. procedure freeAll;
  63. begin
  64.   free(img);
  65.   hfree(vScr);
  66.   hfree(sqrTab);
  67. end;
  68.  
  69. procedure InitData;
  70. var k:word;
  71. begin
  72.   vScr:=halloc(64000);
  73.   sqrTab:=halloc(161*101*2);  { [0..160,0..100] of word }
  74.   Img:=LoadPCX(paramstr(1),@pal);
  75.   if (Img=nil) or (vScr=0) or (sqrTab=0) then begin
  76.     freeAll;
  77.     asm mov ax,3; int 10h end;
  78.     writeln('Not enough memory');
  79.     halt
  80.   end;
  81.   for k:=0 to 255 do SinTab[k]:=trunc(256*sin(k/255*2*pi));
  82. end;
  83.  
  84. procedure PreCalc;  { this shit will take some time... }
  85. var x,y,k:word;     { it could be stored once and loaded from disk every time }
  86.     ff:file;
  87. begin
  88.   for x:=0 to 160 do
  89.     for y:=0 to 100 do begin
  90.       k:=trunc( sqrt( sqr(x) + sqr(y) ) );
  91.       memw[sqrTab:(y*161+x)*2]:=k;
  92.     end;
  93.   (*
  94.   openforoutput(ff,'dist_tab.dat','');
  95.   blockwrite(ff,mem[sqrTab:0],161*101); { just in case you'll ever need it... }
  96.   closefile(ff,'');
  97.   *)
  98. end;
  99.  
  100. var ang:word;
  101.  
  102.  
  103. {
  104.   Rutina asta ar trebui setata sa "introduca" sinusul în unda, sa valureasca
  105.   putin si apoi sa-l "scoata" afara cu scaderea treptata a amplitudinii (în
  106.   felul asta de obtine un efect de "drop"-valuri de picatura de apa).
  107.   (usor de facut, oricum...)
  108.   ---------------------------------------------------------------------------
  109.   "forma de unda" e tinuta în Wave[] (200 de intrari). Intrarea 0 corespunde
  110.   altitudinii "centrului" imaginii generate (centrul cercurilor concentrice).
  111.   Intrarea 199 - celor mai exterioare puncte din figura (extremitatile-colturi,
  112.   margini(?)).
  113.   Sinusul se deplaseaza în forma de unda de la 0 înspre 199, pentru a da
  114.   impresia de "deplasare" a frontului de unda (a "valurilor").
  115. }
  116. procedure UpdateWave;
  117. const Amplitude  : word = 10; { in pixels }             { can vary ! }
  118.       Frequency  : word = 15; { ripples/(160 pixels) }  { can vary ! }
  119. var   k:word;
  120. begin
  121.   inc(ang,1);
  122.   for k:=0 to 189{199} do {189 is the exact value}
  123.     Wave[k]:=Amplitude*sinTab[byte(Frequency*(k-ang))] div 256;
  124. end;
  125.  
  126. procedure DrawRipples;near;external; {$L rip_asm} { the main shit, hehehe }
  127.  
  128. procedure DoIt;
  129. begin
  130.   Precalc;
  131.   repeat
  132.     UpdateWave;
  133.     DrawRipples;
  134.     vWait;
  135.     ShowVScreen;
  136.   until port[$60]=1;
  137. end;
  138.  
  139. begin
  140.   if paramcount=0 then begin
  141.     writeln('RIPPLES FileName.PCX');
  142.     halt
  143.   end;
  144.   InitData;
  145.   InitVideo;
  146.   DoIt;
  147.   asm mov ax,3; int 10h end;
  148.   freeAll;
  149. end.
  150.